The Atari Compendium/The Atari Compendium (Toad Computers) (1994).iso/files/prgtools/modula2/module/preislis.mod

Modula Implementation | 1995-11-25 | 4.9 KB | 211 lines

IMPLEMENTATION MODULE  PreisListe;

FROM SYSTEM IMPORT TSIZE;
FROM Storage IMPORT ALLOCATE,DEALLOCATE;

TYPE PriceList               = POINTER TO PriceListHeader;
     PriceListElementPointer = POINTER TO PriceListElement;
     PriceListHeader         = RECORD
                             current,
                             first,last : PriceListElementPointer;
                          END ;
     PriceListElement        = RECORD
                             next,prev     : PriceListElementPointer;
                             value         : EKPreis
                          END(*RECORD*);

PROCEDURE MakePriceList(VAR L:PriceList);
BEGIN
   ALLOCATE(L,TSIZE(PriceListHeader));
   L^.first:=NIL;
   L^.last:=NIL;
   L^.current:=NIL;
END MakePriceList;

PROCEDURE KillPriceList(VAR L:PriceList);
VAR p,q:PriceListElementPointer;
BEGIN
    p:=L^.first;
    WHILE (p#NIL) DO
      q:=p;
      p:=p^.next;
      DEALLOCATE(q);
    END(*WHILE*);
    DEALLOCATE(L);
    L:=NIL
END KillPriceList;

PROCEDURE First(VAR L:PriceList);
BEGIN
    L^.current:=L^.first;
END First;

PROCEDURE Last(VAR L:PriceList);
BEGIN
    L^.current:=L^.last;
END Last;

PROCEDURE Next(VAR L:PriceList);
BEGIN
   IF (~Empty(L) AND (L^.current^.next # NIL))THEN
      L^.current:=L^.current^.next;
   END(*IF*);
END Next;

PROCEDURE Prev(VAR L:PriceList);
BEGIN
   IF (~Empty(L) AND (L^.current^.prev # NIL))THEN
      L^.current:=L^.current^.prev;
   END(*IF*);
END Prev;

PROCEDURE Empty(VAR L:PriceList):BOOLEAN;
BEGIN
   RETURN L^.first=NIL
END Empty;

PROCEDURE AtFirst(VAR L:PriceList):BOOLEAN;
BEGIN
   RETURN L^.current=L^.first
END AtFirst;

PROCEDURE AtLast(VAR L:PriceList):BOOLEAN;
BEGIN
   RETURN L^.current=L^.last
END AtLast;

PROCEDURE Find(VAR L:PriceList;VAR Value:EKPreis; VAR Finde:FindProc; Key:EKPreis ):BOOLEAN;
VAR OK :BOOLEAN;
BEGIN
    IF ~Empty(L) THEN
       LOOP
          OK:=GetValue(L,Value);
          IF Finde(Value,Key) THEN
             RETURN TRUE
          ELSE
              IF AtLast(L) THEN
                    RETURN FALSE
              END(*IF*);
              Next(L);
          END(*IF*);
       END(*LOOP*);
    ELSE
       RETURN FALSE
    END(*IF*);
END Find;

PROCEDURE FindFirst(VAR L:PriceList;VAR Value:EKPreis; VAR Finde:FindProc; Key:EKPreis):BOOLEAN;
BEGIN
   IF ~Empty(L) THEN
      First(L);
      RETURN Find(L,Value,Finde,Key);
   ELSE
      RETURN FALSE
   END(*IF*);
END FindFirst;

PROCEDURE FindNext(VAR L:PriceList;VAR Value:EKPreis; VAR Finde:FindProc;Key:EKPreis):BOOLEAN;
BEGIN
   IF ~Empty(L) THEN
      Next(L);
      RETURN Find(L,Value,Finde,Key);
   ELSE
      RETURN FALSE
   END(*IF*);
END FindNext;


PROCEDURE GetValue(VAR L:PriceList;VAR Value :EKPreis):BOOLEAN;
VAR i:INTEGER;
BEGIN
   IF ~Empty(L) THEN
         Value:=L^.current^.value;
     RETURN TRUE
   ELSE
     RETURN FALSE
   END(*IF*);
END GetValue;

PROCEDURE SetValue(VAR L:PriceList;Value :EKPreis);
VAR  i:INTEGER;
BEGIN
   IF ~Empty(L) THEN
         L^.current^.value:=Value;
   END(*IF*);
END SetValue;

PROCEDURE EnterElement(VAR L:PriceList);
VAR p,q :PriceListElementPointer;
BEGIN
   ALLOCATE(p,TSIZE(PriceListElement));
   IF Empty(L) THEN
         L^.first:=p;
         L^.last:=p;
         p^.next:=NIL;
         p^.prev:=NIL;
   ELSIF AtFirst(L) THEN
         p^.next:=L^.first;
         L^.first:=p;
         p^.prev:=NIL;
         L^.current^.prev:=p;
   ELSE
         p^.next:=L^.current;
         p^.prev:=L^.current^.prev;
         q:=L^.current^.prev;
         q^.next:=p;
         L^.current^.prev:=p;
  END(*IF*);
  L^.current:=p;
END EnterElement;

PROCEDURE AppendElement(VAR L:PriceList);
VAR p,q :PriceListElementPointer;
BEGIN
   ALLOCATE(p,TSIZE(PriceListElement));
   IF Empty(L) THEN
         L^.first:=p;
         L^.last:=p;
         p^.next:=NIL;
         p^.prev:=NIL;
   ELSIF AtLast(L) THEN
         p^.prev:=L^.last;
         L^.last:=p;
         p^.next:=NIL;
         L^.current^.next:=p;
   ELSE
         p^.next:=L^.current^.next;
         p^.prev:=L^.current;
         q:=L^.current^.next;
         q^.prev:=p;
         L^.current^.next:=p;
  END(*IF*);
  L^.current:=p;
END AppendElement;

PROCEDURE RemoveElement(VAR L:PriceList);
VAR p,q :PriceListElementPointer;
BEGIN
   IF ~Empty(L) THEN
   p:=L^.current;
   IF (AtFirst(L) AND AtLast(L)) THEN
       L^.first:=NIL;
       L^.last:=NIL;
       L^.current:=NIL;
   ELSIF AtFirst(L) THEN
       L^.first:=L^.current^.next;
       L^.first^.prev:=NIL;
       L^.current:=L^.current^.next;
   ELSIF AtLast(L) THEN
       L^.last:=L^.current^.prev;
       L^.last^.next:=NIL;
       L^.current:=L^.current^.prev;
   ELSE
       p^.prev^.next:=p^.next;
       p^.next^.prev:=p^.prev;
       L^.current:=L^.current^.next;
   END(*IF*);
   DEALLOCATE(p);
   END(*IF*);
END RemoveElement;
END PreisListe.